home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / jul90.zip / TIP557.LSP < prev    next >
Text File  |  1990-07-09  |  992b  |  43 lines
  1. ;TIP557.LSP   Show Block Occurrences   (c)1990, Brian Sallade
  2. (defun C:SHBLKS (/ A B C CNTR)
  3.   (setq SEARCH nil)
  4.   (while (= SEARCH nil)
  5.     (setq A (strcase (getstring
  6.         "\nBlock to show or <ALL>: "))
  7.     )
  8.     (If (= A "") (setq A "ALL"))
  9.     (If (= A "ALL")
  10.       (setq SEARCH T)
  11.       (setq SEARCH
  12.         (tblsearch "block" A))
  13.     )
  14.     (If (= SEARCH nil)
  15.       (prompt (strcat
  16.         "No block named " A " found."))
  17.     )
  18.   )
  19.   (setq B (entnext) CNTR 0)
  20.   (While (boundp 'B)
  21.     (setq C (entget B))
  22.     (if (= (cdr (assoc 0 C)) "INSERT")
  23.       (progn
  24.         (If (= A "ALL") (progn
  25.           (setq CNTR (1+ CNTR))
  26.           (redraw (cdr (assoc -1 C)) 3)
  27.         ))
  28.         (If (= (cdr (assoc 2 C)) A)
  29.           (progn
  30.             (setq CNTR (1+ CNTR))
  31.             (redraw (cdr(assoc -1 C)) 3)
  32.           )
  33.         )
  34.       )
  35.     )
  36.     (setq B (entnext B))
  37.   )
  38.   (prompt (strcat "Showed "
  39.     (itoa CNTR) " occurances of " A))
  40. (princ)
  41. )
  42. 
  43.